BBS in a Box 4/BBS in a Box - Macintosh - Volume IV (January 1992) (BBS in a Box).iso/Files/Prog/T/TransDisplay2p.cpt/EventLog.p

Text File | 1988-12-09 | 19.2 KB | 906 lines | [TEXT/PJMM]

{    EventLog - TransDisplay event-logging demonstration program}

{    The project should include EventLog.p (this file), TransDisplay.p}
{    (or a library made from TransDisplay.p), TransSkel.p (or a library}
{    made from TransSkel.ps), and Runtime.lib and Interface.lib.  Also, you'll}
{    need to set the run options to use the file EventLog.proj.rsrc as a resource}
{    file. }

{    8 November 1986    Paul DuBois}

{11 January 1987    Ported to LightSpeed Pascal by Owen Hartnett    }
{Ωhm Software Co., 163 Richard Drive, Tiverton, RI 02878        }

program EventLog;

    uses
{$IFC UNDEFINED THINK_PASCAL}
        Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf,
{$ENDC}
        TransSkel, TransDisplay;

    const

                    { declare zoom box part codes }

        inZoomIN = 7;
        inZoomOut = 8;

        maxButton = 14;

        helpTextRes = 1000;        { help text resource number }
        aboutAlrtRes = 1000;    { About... alert resource number }

                    { Menu resource numbers }

        fileMenuRes = 1000;
        editMenuRes = 1001;
        logMenuRes = 1002;

                    { Window resource numbers }

        LogWindRes = 1000;
        helpWindRes = 1001;
        SelectWindRes = 1002;

            { File menu item numbers }

        showLog = 1;    { make windows visible/bring to front }
        showHelp = 2;
        ShowSelect = 3;
        quit = 5;

                { Edit menu item numbers }

        undo = 1;
        cut = 3;
        copy = 4;
        paste = 5;
        clear = 6;

                { Log menu item numbers }

        logEvents = 1;        { whether events are logged }
        excludeLWind = 2;
        flushLog = 4;                { flush log output }
        wrapStyle = 6;            { word wrap or not }
        leftJust = 8;                { justification }
        centerJust = 9;
        rightJust = 10;
        small = 12;                { text size }
        medium = 13;
        large = 14;
        top = 16;                    { scroll home }
        bottom = 17;                { scroll to bottom }

    type
        booleanPtr = ^Boolean;
        CtrlInfoPtr = ^CtrlInfoRec;
        CtrlInfoRec = record
                loc: Point;        { upper left of control }
                title: Str255;        { control title }
                flagAddr: booleanPtr;    { associated boolean }
                ctrl: ControlHandle;        { associated control }
                subInfo: CtrlInfoPtr;    { subsidiary control }
            end;


    var
        selectWind, helpWind, logWind: WindowPtr;
            { event selection window }
            { help text window }
            { log output window }
        fileMenu, editMenu, logMenu: MenuHandle;
        reportEvents, excludeLog: Boolean;
        { report events or not }
        { exclude log window events or not }
        logFont, logSize: integer;
        logWrap, logJust: integer;
        rMouseDown, rMouseMods, rMouseWind, rMouseLoc: Boolean;
                            { event type selection flags }
        rMousePart, rMouseSys, rMouseUp, rKeyDown, rKDMods: Boolean;
        rAutoKey, rAKMods, rUpdate, rActivate, rDisk: Boolean;
        currentPort: GrafPtr;

{    Control information.  The last field is used to tell which controls}
{    are "owned" by another.  When the owner is unchecked, all the owned}
{    controls go dim.}

        ctrlInfo: array[0..maxButton] of CtrlInfoRec;

{    Window that was in front last time checked    }

        lastFront: WindowPtr;
        h: Handle;
        dummy: Boolean;

{    Do in Pascal what can be done in C as static initializations.  }

    procedure setupStuff;

    begin
        rMouseDown := true;
        rMouseMods := false;
        rMouseWind := true;
        rMouseLoc := false;
        rMousePart := true;
        rMouseSys := false;
        rMouseUP := false;
        rKeyDown := true;
        rKDMods := false;
        rAutoKey := true;
        rAKMods := false;
        rUpdate := true;
        rActivate := true;
        rDisk := true;

        with ctrlInfo[0] do
            begin
                loc.v := 5;
                loc.h := 10;
                title := 'Mouse Down';
                flagAddr := @rMouseDown;
                ctrl := nil;
                subInfo := nil;
            end;

        with ctrlInfo[1] do
            begin
                loc.v := 25;
                loc.h := 30;
                title := 'Modifiers';
                flagAddr := @rMouseMods;
                ctrl := nil;
                subInfo := @ctrlInfo[0];
            end;

        with ctrlInfo[2] do
            begin
                loc.v := 45;
                loc.h := 30;
                title := 'Window';
                flagAddr := @rMouseWind;
                ctrl := nil;
                subInfo := @ctrlInfo[0];
            end;

        with ctrlInfo[3] do
            begin
                loc.v := 65;
                loc.h := 30;
                title := 'Location';
                flagAddr := @rMouseLoc;
                ctrl := nil;
                subInfo := @ctrlInfo[0];
            end;

        with ctrlInfo[4] do
            begin
                loc.v := 85;
                loc.h := 30;
                title := 'Part Code';
                flagAddr := @rMousePart;
                ctrl := nil;
                subInfo := @ctrlInfo[0];
            end;

        with ctrlInfo[5] do
            begin
                loc.v := 105;
                loc.h := 30;
                title := 'System Clicks';
                flagAddr := @rMouseSys;
                ctrl := nil;
                subInfo := @ctrlInfo[0];
            end;

        with ctrlInfo[6] do
            begin
                loc.v := 125;
                loc.h := 10;
                title := 'Mouse Up';
                flagAddr := @rMouseUp;
                ctrl := nil;
                subInfo := nil;
            end;

        with ctrlInfo[7] do
            begin
                loc.v := 5;
                loc.h := 160;
                title := 'Key Down';
                flagAddr := @rKeyDown;
                ctrl := nil;
                subInfo := nil;
            end;

        with ctrlInfo[8] do
            begin
                loc.v := 25;
                loc.h := 180;
                title := 'Modifiers';
                flagAddr := @rKDMods;
                ctrl := nil;
                subInfo := @ctrlInfo[7];
            end;

        with ctrlInfo[9] do
            begin
                loc.v := 45;
                loc.h := 180;
                title := 'AutoKey';
                flagAddr := @rAutoKey;
                ctrl := nil;
                subInfo := nil;
            end;

        with ctrlInfo[10] do
            begin
                loc.v := 65;
                loc.h := 180;
                title := 'Modifiers';
                flagAddr := @rAKMods;
                ctrl := nil;
                subInfo := @ctrlInfo[9];
            end;

        with ctrlInfo[11] do
            begin
                loc.v := 85;
                loc.h := 160;
                title := 'Update';
                flagAddr := @rUpdate;
                ctrl := nil;
                subInfo := nil;
            end;

        with ctrlInfo[12] do
            begin
                loc.v := 105;
                loc.h := 160;
                title := 'Activate';
                flagAddr := @rActivate;
                ctrl := nil;
                subInfo := nil;
            end;

        with ctrlInfo[13] do
            begin
                loc.v := 125;
                loc.h := 160;
                title := 'Disk';
                flagAddr := @rDisk;
                ctrl := nil;
                subInfo := nil;
            end;

        lastFront := nil;
    end;

{    Print information about a window.  If it's a window with a title,}
{    print the title.  Print whether it's a}
{    desk accessory window.}

    procedure WindowInfo (theWind: WindowPeek);

        var
            title: Str255;

    begin
        GetWTitle(WindowPtr(theWind), title);
        if length(title) > 0 then            { window has title }
            begin
                DisplayChar(' ');
                DisplayString(title);
            end;
        if theWind^.windowKind < 0 then
            DisplayString(' (DA)');
    end;

    procedure Modifiers (mods: integer);

    begin
        DisplayString(' mods ($');
        DisplayHexInt(mods);
        DisplayChar(')');
    end;

    procedure MouseLoc (thePt: Point; thePort: GrafPtr);

        var
            savePort: GrafPtr;

    begin
        GetPort(savePort);
        SetPort(thePort);
        GlobalToLocal(thePt);
        SetPort(savePort);
        if rMouseLoc then
            begin
                DisplaySTring(' loc (');
                DisplayInt(thePt.h);
                DisplayString(', ');
                DisplayInt(thePt.v);
                DisplayChar(')');
            end;
    end;

{    Mouse click.  Get the window that the click occurred in, and the}
{    part of the window.}

{    Make sure to get all the part codes!  (incl. zoom box stuff)}

    procedure ReportMouse (theEvent: EventRecord);

        var
            evtPt: Point;
            evtpart: integer;
            evtport: GrafPtr;

    begin
        evtPt := theEvent.where;
        evtPart := FindWindow(evtPt, evtPort);
        if not excludeLog or (evtPort <> logWind) then
            begin
                DisplayString('Mouse Click');
                case evtPart of
                    inSysWindow:

{    Click in a desk accessory window.}

                        if rMouseSys then
                            begin
                                if rMousePart then
                                    DisplayString(' in system window:');
                                if rMouseWind then
                                    WindowInfo(WindowPeek(evtPort));
                                MouseLoc(evtPt, evtport);
                            end;
                    inDesk:

{    Click in desk top.}

                        if rMousePart then
                            DisplayString(' in desktop');
                    inMenuBar:

{    Click in menu bar.}

                        if rMousePart then
                            DisplayString(' in menu bar');
                    inGrow:

{    Click in grow box.}

                        begin
                            if rMousePart then
                                DisplayString(' in grow region:');
                            if rMouseWind then
                                WindowInfo(WindowPeek(evtPort));
                            MouseLoc(evtPt, evtPort);
                        end;
                    inDrag:

{    Click in title bar.}

                        begin
                            if rMousePart then
                                DisplayString(' in drag region:');
                            if rMouseWind then
                                WindowInfo(WindowPeek(evtPort));
                        end;
                    inGoAway:

{    Click in close box.}

                        begin
                            if rMousePart then
                                DisplayString(' in close box:');
                            if rMouseWind then
                                WindowInfo(WindowPeek(evtPort));
                        end;
                    inZoomIn:

{    Click in zoom-in box.}

                        begin
                            if rMousePart then
                                DisplayString(' in zoom-in box:');
                            if rMouseWind then
                                WindowInfo(WindowPeek(evtPort));
                        end;
                    inZoomOut:

{    Click in zoom-out box.}

                        begin
                            if rMousePart then
                                DisplayString(' in zoom-out box:');
                            if rMouseWind then
                                WindowInfo(WindowPeek(evtPort));
                        end;
                    inContent:

{    Click in content region.}

{    (Might also check in in control, and if so, print control information)}

                        begin
                            if rMousePart then
                                DisplayString(' in content region:');
                            if rMouseWind then
                                WindowInfo(WindowPeek(evtPort));
                            MouseLoc(evtPt, evtPort);
                        end;
                    otherwise
                end;
                if rMouseMods then
                    Modifiers(theEvent.modifiers);
                DisplayLn;
            end;
    end;

    procedure ReportKey (what: integer; c: char; mods: integer; modFlag: Boolean);
    begin
        if what = keyDown then
            DisplayString('Key Down: char "')
        else
            DisplayString('Autokey: char"');
        DisplayChar(c);
        DisplayString('" ');
        if modFlag then
            Modifiers(mods);
        Displayln;
    end;

    procedure ReportActivate (theWind: WindowPtr; mods: integer);

    begin
        if BitAnd(mods, activeFlag) <> 0 then
            DisplayString('Activate:')
        else
            DisplayString('Deactivate:');
        WindowInfo(WindowPeek(theWind));
        DisplayLn;
    end;

    procedure ReportUpdate (theWind: WindowPtr);

    begin
        DisplayString('Update:');
        WindowInfo(WindowPeek(theWind));
        Displayln;
    end;

{    General event logger}

    function Logevent (theEvt: EventRecord): Boolean;

        var
            theEvent: EventRecord;
            evtPt: Point;
            evtPort: GrafPtr;
            evtpart: integer;
            evtChar: char;
            evtMods: integer;
            r: Rect;

    begin
        if reportEvents = false then
            logevent := false
        else
            begin
                theEvent := theEvt;
                evtPt := theEvent.where;
                case theEvent.what of
                    mouseDown:

{    Mouse click.}

                        if rMouseDown then
                            ReportMouse(theEvent);
                    mouseUp:
                        if rMouseUP then
                            begin
                                DisplayString('Mouse Up');
                                Displayln;
                            end;
                    keyDown:

{    Key event.}

                        if not (excludeLog and (FrontWindow = logWind)) then
                            if rKeyDown then
                                begin
                                    evtChar := char(BitAnd(theEvent.message, charCodeMask));
                                    evtMods := theEvent.modifiers;
                                    ReportKey(keyDown, evtChar, evtMods, rKDMods);
                                end;
                    autoKey:
                        if not (excludeLog and (FrontWindow = logWind)) then
                            if rKeyDown then
                                begin
                                    evtChar := char(BitAnd(theEvent.message, charCodeMask));
                                    evtMods := theEvent.modifiers;
                                    ReportKey(keyDown, evtChar, evtMods, rKDMods);
                                end;
                    updateEvt:

{    Update a window.  If it's an update for the log window, invalidate}
{    it, because the message is written and will cause a scroll BEFORE}
{    the window actually gets updated.  This means that part of what}
{    needs redrawing will be scrolled out of the update region and won't}
{    be redrawn properly.  Invalidating the entire port is wasteful but}
{    makes sure the whole window can be drawn properly.}

                        begin
                            if WindowPtr(theEvent.message) = logWind then
                                begin
                                    SetPort(logWind);
                                    InvalRect(logWind^.portRect);
                                end;
                            if not (excludeLog and (WindowPtr(theEvent.message) = logWind)) then
                                if rUpdate then
                                    begin
                                        ReportUpdate(WindowPtr(theEvent.message));
                                    end;
                        end;
                    activateEvt:

{    Activate or deactivate a window.}

                        if not (excludeLog and (WindowPtr(theEvent.message) = logWind)) then
                            if rActivate then
                                begin
                                    ReportActivate(WindowPtr(theEvent.message), theEvent.modifiers);
                                end;
                    diskEvt:

{    handle inserts of uninitialized disks}

                        if rDisk then
                            begin
                                DisplayString('Disk insertion');
                                if HiWord(theEvent.message) <> noErr then
                                    DisplayString(' (needs initializing)');
                                Displayln;
                            end;
                    otherwise
                end;
                logEvent := false;
            end;
    end;

{    Background procedure.  Check front window, reset edit menu if window}
{    changes from an application window to a non-application window.}
{    Disable the Edit menu whenever an application window is active,}
{    enable it otherwise.}
{    Also called whenever it is known that the active window has changed.}

    procedure CheckFront;

        var
            curWind: WindowPtr;
            theKind: integer;
            lastIsApp, curIsApp: Boolean;
            mypeek: WindowPeek;

    begin
        curIsApp := false;
        lastIsApp := false;
        curWind := frontwindow;
        if (IsDWindow(lastFront)) or (lastFront = selectWind) then
            lastIsApp := true;
        if (IsDWindow(curWind)) or (curWind = selectWind) then
            curIsApp := true;
        if lastFront <> curWind then
            begin
                if (IsDWindow(lastFront)) or (lastFront = selectWind) then
                    lastIsApp := true;
                if (IsDWindow(curWind)) or (curWind = selectWind) then
                    curIsApp := true;
                if lastIsApp <> curIsApp then
                    begin
                        theKind := 0;
                        if curWind <> nil then
                            begin
                                mypeek := windowpeek(curWind);
                                theKind := mypeek^.windowKind;
                            end;
                        if (curWind = nil) or (theKind < 0) then    { no window or DA in front }
                            EnableItem(editMenu, 0)
                        else
                            DisableItem(editMenu, 0);
                        DrawMenuBar;
                    end;
                lastFront := curWind;
            end;
    end;

{ ------------------------------------------------------------ }
{            Event Selection Window Handler Routines                }
{ ------------------------------------------------------------ }



{    Activate event procedure for both display windows and the checkbox}
{    window.}

    procedure Activate (active: Boolean);

    begin
        CheckFront;
    end;

{    Update window.  This is easy, just draw the controls.}

    procedure Update (resized: Boolean);

    begin
        DrawControls(selectwind);
        getPort(currentPort);
    end;

{    Handle hits in check boxes:}
{    Toggle check box, sync the associated flag, and enable or disable}
{    any subsidiary check boxes accordingly.  (Subsidiaries have}
{    information in the control structure that points back to the owner}
{    check box.)}

    procedure Mouse (thePt: Point; t: longint; mods: integer);

        var
            ctl: ControlHandle;
            ci: CtrlInfoPtr;
            val: boolean;
            i: integer;
            genericPtr: BooleanPtr;

    begin
        if FindControl(thePt, selectWind, ctl) <> 0 then
            if TrackControl(ctl, thePt, nil) <> 0 then
                begin
                    ci := CtrlInfoPtr(GetCRefcon(ctl));
                    val := not (GetCtlValue(ctl) <> 0);
                    genericPtr := BooleanPtr(ci^.flagAddr);
                    genericPtr^ := val;
                    SetCtlValue(ctl, integer(val));

            { enable/disable any subsidiaries }

                    for i := 0 to maxButton - 1 do
                        if ctrlInfo[i].subinfo <> nil then
                            if ctrlInfo[i].subInfo^.ctrl = ci^.ctrl then
                                if val then
                                    HiliteControl(ctrlInfo[i].ctrl, 0)
                                else
                                    HiliteControl(ctrlInfo[i].ctrl, 255);
                end
    end;

{    File menu handler}

    procedure DoFileMenu (item: integer);

    begin
        case item of
            showHelp:
                begin
                    SelectWindow(helpWind);
                    ShowWindow(helpWind);
                end;
            showSelect:
                begin
                    SelectWindow(selectWind);
                    ShowWindow(selectWind);
                end;
            showLog:
                begin
                    SelectWindow(logWind);
                    ShowWindow(logWind);
                end;
            quit:
                SkelWhoa;
            otherwise
        end;
    end;

{    Put the right check marks in the Log menu}

    procedure SetLogMenu;

    begin
        CheckItem(logMenu, logEvents, reportEvents);
        CheckItem(logMenu, excludeLWind, excludeLog);
        CheckItem(logMenu, wrapStyle, logWrap >= 0);
        CheckItem(logMenu, leftJust, logJust = teJustLeft);
        CheckItem(logMenu, centerJust, logjust = teJustCenter);
        CheckItem(logMenu, rightJust, logJust = teJustRight);
        CheckItem(logMenu, small, logsize = 9);
        CheckItem(logMenu, medium, logsize = 12);
        CheckItem(logMenu, large, logSize = 24);
    end;

{    Set display style of log window}

    procedure SetStyle;

    begin
        SetDWindowStyle(logWind, logFont, logSize, logWrap, logJust);
        SetLogMenu;
    end;

{    Log menu handler}

    procedure DoLogMenu (item: integer);

    begin
        case item of
            logEvents:
                begin
                    reportEvents := not reportEvents;
                    SetLogMenu;
                end;
            excludeLWind:
                begin
                    excludeLog := not excludeLog;
                    SetLogMenu;
                end;
            flushLog:
                FlushDWindow(logWind, longint(32767));
            wrapStyle:
                begin
                    if logWrap >= 0 then
                        logWrap := -1
                    else
                        logWrap := 0;
                    SetStyle;
                end;
            leftJust:
                begin
                    logJust := teJustLeft;
                    SetStyle;
                end;
            centerJust:
                begin
                    logJust := teJustCenter;
                    SetStyle;
                end;
            rightJust:
                begin
                    logJust := teJustRight;
                    SetStyle;
                end;
            small:
                begin
                    logFont := monaco;
                    logSize := 9;
                    SetStyle;
                end;
            medium:
                begin
                    logFont := systemFont;
                    logSize := 12;
                    SetStyle;
                end;
            large:
                begin
                    logFont := geneva;
                    logSize := 24;
                    SetStyle;
                end;
            top:
                SetDWindowPos(logWind, 0);
            bottom:
                SetDWindowPos(logWind, 32767);
            otherwise
        end;
    end;

{    Handle selection of About… item from Apple menu}

    procedure DoAbout;

        var
            ignore: integer;

    begin
        ignore := Alert(aboutAlrtRes, nil);
    end;

{    Dispose of event selection window (and controls)}

    procedure WClobber;

    begin
        DisposeWindow(selectWind);
    end;

{    Create controls}

    procedure MakeControls (theWind: windowPtr);

        var
            i: integer;
            ci: CtrlInfoPtr;
            r: Rect;
            genericPtr: booleanPtr;

    begin
        for i := 0 to maxButton - 1 do
            begin
                ci := @ctrlInfo[i];
                SetRect(r, ci^.loc.h, ci^.loc.v, ci^.loc.h + StringWidth(ci^.title) + 30, ci^.loc.v + 20);
                genericPtr := ci^.flagAddr;
                ci^.ctrl := NewControl(theWind, r, ci^.title, true, integer(genericPtr^), 0, 1, checkBoxProc, longint(ci));
            end;
        ValidRect(theWind^.portRect);
    end;

begin
    SetupStuff;
    SkelInit(6, nil);
    TransDisplayInit;
    SkelApple('About EventLog...', @DoAbout);
    fileMenu := GetMenu(fileMenuRes);
    dummy := SkelMenu(fileMenu, @DoFileMenu, nil, false);

    editMenu := GetMenu(editMenuRes);
    DisableItem(editmenu, 0);
    dummy := SkelMenu(editMenu, nil, nil, false);

    logMenu := GetMenu(logMenuRes);
    dummy := Skelmenu(logMenu, @DoLogmenu, nil, true);

{    Create windows and install handlers.}

    SetDwindowNotify(nil, @Activate);

    helpWind := GetNEwDWindow(helpWindRes, WindowPtr(-1));
    SetDWindowStyle(helpWind, 0, 0, 0, teJustLeft);

    h := GetREsource('TEXT', helpTextRes);    { read help text }
    HLock(h);                            { lock it and write to window }
    DisplayText(h^, GetHandleSize(h));
    HUnlock(h);
    ReleaseResource(h);                { done with it, so goodbye }
    SetDWindowPos(helpWind, 0);        { scroll back to top }
    ShowWindow(helpWind);

    logWind := GetNewDWindow(logWindRes, WindowPtr(-1));

    SkelEventHook(@logEvent);
    reportEvents := true;
    excludeLog := false;

    logFont := monaco;
    logSize := 9;
    logWrap := 0;
    logJust := teJustLeft;
    SetStyle;
    ShowWindow(logWind);

    selectWind := GetNewWindow(selectWindRes, nil, WindowPtr(-1));

    dummy := SkelWindow(selectWind, @Mouse, nil, @Update, @Activate, nil, @WClobber, nil, true);
        { the window }
        { mouse click handler }
        { key clicks are ignored }
        { window updating procedure }
        { window activate/deactivate procedure }
        { hide window }
        { window disposal procedure }
        { idle proc }
        { irrelevant }

    MakeControls(selectWind);

{    Process events until user quits,}
{    then clean up and exit}

    CheckFront;
    SelectWindow(HelpWind);
    SkelBackground(@CheckFront);
    SkelMain;
    SkelClobber;
end.